home *** CD-ROM | disk | FTP | other *** search
/ MacHack 1993 / MacHack 1993.toast / MacHack™ 1987-1992 / MacHack™ '90 / Source Code ƒ / Modula2 ƒ / DataStack Filer / DemoTest.mod < prev    next >
Encoding:
Text File  |  1990-06-15  |  2.2 KB  |  100 lines  |  [TEXT/MPS ]
  1. MODULE DemoTest;
  2. (*    Copyright:    © 1990 by Keith Nemitz, all rights reserved. *)
  3.  
  4. FROM SYSTEM IMPORT ADDRESS,ADR;
  5.  
  6. FROM Strings IMPORT Length,MakePascalString,MakeModulaString;
  7.  
  8. FROM MacTypes IMPORT Debugger,debugstr,OSErr,Str255,Str31;
  9. FROM FileManager IMPORT HGetVol;
  10. FROM ResourceManager IMPORT ResError;
  11. FROM QuickDraw IMPORT Random;
  12. ### Help - "FROM QuickDraw IMPORT Random;" was not found.
  13.  
  14.  
  15. FROM InOut IMPORT WriteString,WriteLongInt,WriteLongCard,WriteLn;
  16. FROM IntEnv IMPORT Exit;
  17.  
  18. FROM LocLib IMPORT CopyStr;
  19. FROM StackFiles IMPORT StackFile,NewStackFile,GetStackFile,CloseStackFile,
  20.         GetDataStack,SaveStackFile;
  21. FROM DataStacks IMPORT AddCard,GetCardByID,DataStack,GetCardByName,
  22.         RemoveCard,InNameOrderDo,CountCards,GetCardName,GetCardIndx,
  23.         GetCardID,SetCardName;
  24.  
  25. TYPE
  26.     ong = RECORD
  27.                 s :ARRAY [0..23] OF CHAR;
  28.                 n :LONGINT;
  29.                 END;
  30.  
  31. VAR
  32.     vRef,err :INTEGER;
  33.     dirID :LONGINT;
  34.     sf :StackFile;
  35.     ds :DataStack;
  36.     str,sss :Str255;
  37.     i,j,seed :CARDINAL;
  38.     xOng :ong;
  39.  
  40.  
  41.  
  42. PROCEDURE RandomRange(m,n :CARDINAL):CARDINAL;
  43. BEGIN
  44.     RETURN (VAL(CARDINAL,Random()) MOD (n-m+1)) + m;
  45.     END RandomRange;
  46.  
  47. PROCEDURE MakeRandomName(VAR s:ARRAY OF CHAR);
  48. VAR
  49.     i,n,x :CARDINAL;
  50. BEGIN
  51.     n := RandomRange(2,27);
  52.     FOR i := 1 TO n DO
  53.         x := RandomRange(ORD(' '),ORD('z'));
  54.         s[i] := CHR(x);
  55.         END;
  56.     s[0] := CHR(n);
  57.     END MakeRandomName;
  58.  
  59.     
  60. BEGIN
  61.     err := ResError();
  62.     str := "";
  63.     IF HGetVol(NIL,vRef,dirID) # 0 THEN Exit(1); END;
  64.     
  65.     sf := NewStackFile('MainTest',vRef,dirID,100,1036,207);
  66.     IF VAL(ADDRESS,sf) = NIL THEN 
  67.         WriteString("failed to open stack"); WriteLn;
  68.         Exit(1);
  69.         END;
  70.     ds := GetDataStack(sf);
  71.  
  72.  
  73.     FOR i := 1 TO 5000 DO
  74.         MakeRandomName(str); (* pascal string *)
  75.         IF AddCard(ds,ADR(xOng),str) = 0 THEN
  76.             WriteString('Did not add card:'); WriteLongCard(i,7); WriteLn;
  77.             Exit(1);
  78.             END;
  79.         END;
  80.  
  81.     FOR i := 1 TO 1000 DO
  82.         RemoveCard(ds,RandomRange(1,CountCards(ds)),0);
  83.         END;
  84.  
  85.     FOR i := 1 TO CountCards(ds) DO
  86.         GetCardName(ds,0,GetCardID(ds,i,""),str);
  87.         j := GetCardIndx(ds,GetCardID(ds,0,""),str);
  88.         IF j = 0 THEN
  89.             WriteString('Bad Lookup');
  90.             MakeModulaString(str,sss);
  91.             WriteString(sss);
  92.             WriteLongInt(VAL(LONGINT,i),8); WriteLn;
  93.             Exit(1); 
  94.             END;
  95.         END;
  96.  
  97.     (* SaveStackFile(sf); *)
  98.     CloseStackFile(sf);
  99.  
  100. END DemoTest.